Delphi Developer's Kit 1996/Delphi Developer's Kit 1996.iso/power/extfile/extfile.pas

Pascal/Delphi Source File | 1995-12-22 | 6KB | 209 lines

{-------------------------------------------------------------------}
{ EXTFILE - Extended FileListbox: shows size, date & time of files  }
{ v. 1.00 July, 21 1995                                             }
{-------------------------------------------------------------------}
{ Copyright Enrico Lodolo                                           }
{ via F.Bolognese 27/3 - 440129 Bologna - Italy                     }
{ CIS 100275,1255 - Internet [e-mail]                 }
{-------------------------------------------------------------------}

unit ExtFile;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, FileCtrl;

type
  TExtFileListBox = class(TFileListBox)
  private
    FShowSize:Boolean;
    FShowDate:Boolean;
    FShowTime:Boolean;
    FSizePos:Integer;
    FDatePos:Integer;
    FTimePos:Integer;
    FNameWd:Integer;
    FSizeWd:Integer;
    FDateWd:Integer;
    FTimeWd:Integer;
    procedure SetShowSize(Value:Boolean);
    procedure SetShowDate(Value:Boolean);
    procedure SetShowTime(Value:Boolean);
    procedure SetSizePos(Value:Integer);
    procedure SetDatePos(Value:Integer);
    procedure SetTimePos(Value:Integer);
  protected
    procedure SetWidths;
    procedure DrawItem(Index:Integer;Rect:TRect;State:TOwnerDrawState); override;
  public
    constructor Create(AOwner:TComponent); override;
  published
    property ShowSize:Boolean read FShowSize write SetShowSize default True;
    property ShowDate:Boolean read FShowDate write SetShowDate default True;
    property ShowTime:Boolean read FShowTime write SetShowTime default True;
    property SizePos:Integer read FSizePos write SetSizePos default -1;
    property DatePos:Integer read FDatePos write SetDatePos default -1;
    property TimePos:Integer read FTimePos write SetTimePos default -1;
  end;

procedure Register;

implementation

procedure TExtFileListBox.SetShowSize(Value:Boolean);

begin
     if Value<>FShowSize then
       begin
         FShowSize:=Value;
         Update;
       end;
end;

procedure TExtFileListBox.SetShowDate(Value:Boolean);

begin
     if Value<>FShowDate then
       begin
         FShowDate:=Value;
         Update;
       end;
end;
procedure TExtFileListBox.SetShowTime(Value:Boolean);

begin
     if Value<>FShowTime then
       begin
         FShowTime:=Value;
         Update;
       end;
end;

procedure TExtFileListBox.SetSizePos(Value:Integer);

begin
     if Value<>FSizePos then
       begin
         FSizePos:=Value;
         Update;
       end;
end;

procedure TExtFileListBox.SetDatePos(Value:Integer);

begin
     if Value<>FDatePos then
       begin
         FDatePos:=Value;
         Update;
       end;
end;

procedure TExtFileListBox.SetTimePos(Value:Integer);

begin
     if Value<>FTimePos then
       begin
         FTimePos:=Value;
         Update;
       end;
end;

constructor TExtFileListBox.Create(AOwner:TComponent);

{-- Creates the component and sets the defaults }

begin
     inherited Create(AOwner);
     FShowSize:=True;
     FShowDate:=True;
     FShowTime:=True;
     FSizePos:=-1;
     FDatePos:=-1;
     FTimePos:=-1;
end;

procedure TExtFileListBox.SetWidths;

{-- Calculates the max. widths of name, size, date and time }

begin
     with Canvas do
       begin
         FNameWd:=TextWidth('aaaaaaaa.mmm');
         FSizeWd:=TextWidth('888888888');
         FDateWd:=TextWidth('888/88/88');
         FTimeWd:=TextWidth('888.88.88');
       end;
end;

procedure TExtFileListBox.DrawItem(Index:Integer;Rect:TRect;
                                   State: TOwnerDrawState);

{-- Draws a line of the ListBox }

var Bitmap: TBitmap;
    Offset: Integer;
    OldAlign: Word;
    SR: TSearchRec;
    DT: TDateTime;
    St:String;

begin
     inherited DrawItem(Index,Rect,State);
     with Canvas do
       begin
         SetWidths;
         Offset:=Rect.Left+FNameWd;
         if (FShowGlyphs=True) and (Bitmap<>nil) then
           begin
             Bitmap:=TBitmap(Items.Objects[Index]);
             Offset:=Offset+Bitmap.Width+6;
           end;
         {-- Retrieves Size, Date and Time of the current file }
         if Directory[Length(Directory)]='\' then
           St:=Directory+Items[Index]
         else St:=Directory+'\'+Items[Index];
         FindFirst(St,faAnyFile,SR);
         DT:=FileDateToDateTime(SR.Time);
         {-- Right alignes the text }
         OldAlign:=SetTextAlign(Handle,ta_right);
         if FShowSize then
           begin
             if FSizePos=-1 then Offset:=Offset+FSizeWd
             else Offset:=FSizePos;
             TextOut(Offset,Rect.Top,IntToStr(SR.Size));
           end;
         if FShowDate then
           begin
             if FDatePos=-1 then Offset:=Offset+FDateWd
             else Offset:=FDatePos;
             try
               TextOut(Offset,Rect.Top,DateToStr(DT));
             finally
             end;
           end;
         if FShowTime then
           begin
             if FTimePos=-1 then Offset:=Offset+FTimeWd
             else Offset:=FTimePos;
             try
             TextOut(Offset,Rect.Top,TimeToStr(DT));
             finally
             end;
           end;
         {-- Sets the text alignment to the original value }
         SetTextAlign(Handle,OldAlign);
       end;
end;

procedure Register;

begin
     RegisterComponents('Samples', [TExtFileListBox]);
end;

end.